{ ********************************************************** }
{                                                            }
{  Loose translation of ZoomRects() from an early release    }
{    of the Apple Software Supplement.                       }
{                                                            }
{ ********************************************************** }

unit utilities;

interface

	const
		ZOOMSTEPS = 16;
		ONE = 65536;
		CurDirStorePtr = $0398;

	var
		fract: Fixed;
		CurDirStore: ^longint;

	function HFSRunning: boolean;
	function NewRoms: boolean;
	function blend (i1, i2: integer): integer;
	procedure zoomrect (smallrect, bigrect: Rect; zoomup: boolean);
	procedure ltog (var r: Rect);
	procedure zoomport (wind: WindowPtr; up: Boolean);
	procedure centerwindow (wind: WindowPtr; r: Rect);
	procedure centerrect (var r1: Rect; r2: Rect);
	function TrackMyRect (aPoint: Point; r1: Rect; rad1, rad2: integer): Boolean;
	procedure DoAdjust (var r: Rect);
	procedure DoShowDialog (Dptr: DialogPtr);
	procedure get_resource_error (rtype: Str255; id: integer);
	procedure show_io_err (err: OSErr);


implementation

	function HFSRunning;

		const
			FSFCBLen = $3F6;

		var
			HFS: ^integer;

	begin
		HFS := pointer(FSFCBLen);
		HFSRunning := (HFS^ > 0);
	end;

	function NewRoms;

		const
			NewRomsID = 117;

		var
			RomVersion, Machine: integer;

	begin
		Environs(RomVersion, Machine);
		NewRoms := RomVersion >= NewRomsID;
	end;

	function blend;

		var
			smallFix, bigFix, tempFix: Fixed;

	begin
		smallFix := ONE * i1;
		bigFix := ONE * i2;
		tempFix := FixMul(fract, bigFix) + FixMul(ONE - fract, smallFix);
		blend := FixRound(tempFix);
	end;

	procedure zoomrect;

		var
			factor: Fixed;
			rect1, rect2, rect3, rect4: Rect;
			savePort, deskPort: GrafPtr;
			i: integer;

	begin
		GetPort(savePort);
		deskPort := GrafPtr(NewPtr(sizeof(GrafPort)));
		OpenPort(deskPort);
		InitPort(deskPort);
		SetPort(deskPort);
		PenPat(gray);
		PenMode(notPatXor);
		if zoomup then
			begin
				rect1 := smallrect;
				factor := FixRatio(6, 5);
				fract := FixRatio(541, 10000);
			end
		else
			begin
				rect1 := bigrect;
				factor := FixRatio(5, 6);
				fract := ONE;
			end;
		rect2 := rect1;
		rect3 := rect1;
		FrameRect(rect1);
		for i := 1 to ZOOMSTEPS do
			begin
				rect4.left := blend(smallrect.left, bigrect.left);
				rect4.right := blend(smallrect.right, bigrect.right);
				rect4.top := blend(smallrect.top, bigrect.top);
				rect4.bottom := blend(smallrect.bottom, bigrect.bottom);
				FrameRect(rect4);
				FrameRect(rect1);
				rect1 := rect2;
				rect2 := rect3;
				rect3 := rect4;
				fract := FixMul(fract, factor);
			end;
		FrameRect(rect1);
		FrameRect(rect2);
		FrameRect(rect3);
		ClosePort(deskPort);
		DisposPtr(Ptr(deskPort));
		PenNormal;
		SetPort(savePort);
	end;

{ ********************************************************** }
{                                                            }
{       procedure ltog(r : Rect);                            }
{                                                            }
{  Converts the Rect referenced by r from local to global    }
{  coordinate system.                                        }
{                                                            }
{ ********************************************************** }


	procedure ltog;

		var
			p1, p2: Point;

	begin
		p1 := r.topLeft;
		p2 := r.botRight;
		LocalToGlobal(p1);
		LocalToGlobal(p2);
		Pt2Rect(p1, p2, r);
	end;

{ ********************************************************** }
{                                                            }
{     procedure zoomport(wind:WindowPtr;up:Boolean);         }
{                                                            }
{   Zooms the window referenced by "wind" either from an     }
{   inivisible state to a visible state, or vice versa. Pass }
{   TRUE in the "up" Boolean parameter to zoom a window to   }
{   open, an FALSE to zoom it close.  The WindowPtr must     }
{   have already been created elsewhere, and zooming the     }
{   window invisible only hides the window, it does not      }
{   destroy the WindowPtr data.                              }
{                                                            }
{ ********************************************************** }

	procedure zoomport;

		var
			r1, r2, r3: Rect;

	begin
		SetPort(wind);
		SetRect(r1, 0, 20, 0, 20);
		r3 := wind^.portRect;
		r2 := r3;
		InsetRect(r2, (r3.right - r3.left + 20) div 2, (r3.bottom - r3.top + 20) div 2);

		ltog(r2);
		ltog(r3);

		if up then
			begin
				zoomrect(r1, r2, TRUE);
				zoomrect(r2, r3, TRUE);
				ShowWindow(wind);
				SetPort(wind);
			end
		else
			begin
				HideWindow(wind);
				zoomrect(r2, r3, FALSE);
				zoomrect(r1, r2, FALSE);
			end;
	end;

{********************************************************************}
{                                                                    }
{     procedure centerwindow(wind:WindowPtr;r:Rect);                 }
{                                                                    }
{   centers the window referenced by the WindowPtr: wind within      }
{   the Rect referenced by the Rect* r.  To center a window in       }
{   the Macintosh screen, (or primary screen if using a Mac II),     }
{   call...                                                          }
{                                                                    }
{     centerwindow(theWindow,&screenBits.bounds);                    }
{                                                                    }
{********************************************************************}

	procedure centerwindow;

		var
			r2: Rect;
			windW, windH: integer;
			rectW, rectH: integer;
			newW, newH: integer;

	begin
		r2 := wind^.portRect;
		windW := r2.right - r2.left;
		windH := r2.bottom - r2.top;
		rectW := r.right - r.left;
		rectH := r.bottom - r.top;
		newW := r.left + (rectW - windW) div 2;
		newH := r.top + (rectH - windH) div 2;
		MoveWindow(wind, newW, newH, FALSE);
	end;

{********************************************************************}
{                                                                    }
{        procedure centerrect(r1,r2:Rect);                           }
{                                                                    }
{   centers the rectangle referenced by the Rect* r1 within          }
{   the Rect referenced by the Rect* r2.  To center the Rect         }
{   innerRect within the Rect outerRect, call...                     }
{                                                                    }
{        centerrect(&innerRect,&outerRect);                          }
{                                                                    }
{********************************************************************}

	procedure centerrect;

	begin
		OffsetRect(r1, ((r2.right - r2.left) - (r1.right - r1.left)) div 2 - r1.left, ((r2.bottom - r2.top) - (r1.bottom - r1.top)) div 2 - r1.top);
	end;


{********************************************************************}
{                                                                    }
{ Function TrackMyRect(aPoint:Point;r1:Rect;rad1,rad2:integer):Boolean; }
{                                                                    }
{   TrackMyRect() treats the Rect referenced by *r1 much like        }
{   the TrackControl(ControlHandle) of the Control Manager. The      }
{   point passed by aPoint should be the local coordinates of the    }
{   mouse down location in the window in which the Rect resides,     }
{   and should initially be called with the mouse location inside    }
{   of the Rect.                                                     }
{                                                                    }
{   rad1 and rad2 are radii for rounded rects, pass 0 in these       }
{   values if the Rect is not rounded.                               }
{                                                                    }
{   Sample Code Fragment....                                         }
{                                                                    }
{   thePoint     : Point;                                            }
{   myRect       : Rect;                                             }
{   rectSelected : Boolean;                                          }
{                                                                    }
{   thePoint := theEvent.where;                                      }
{   GlobalToLocal(&thePoint);                                        }
{   if (PtInRect(thePoint,&myRect))                                  }
{       rectSelected := TrackMyRect(thePoint,&myRect,0,0);           }
{                                                                    }
{********************************************************************}

	function TrackMyRect;

		var
			returnVal: boolean;

	begin
		returnVal := TRUE;
		InvertRoundRect(r1, rad1, rad2);
		repeat
			begin
				GetMouse(aPoint);
				if (PtInRect(aPoint, r1) <> returnVal) then
					begin
						returnVal := not returnVal;
						InvertRoundRect(r1, rad1, rad2);
						SystemTask;
					end;
			end;
		until StillDown;
		GetMouse(aPoint);
		TrackMyRect := PtInRect(aPoint, r1);
	end;

	procedure DoAdjust;

		var
			x, y, xd, yd: LongInt;

	begin
		if not ((screenBits.bounds.right = 512) and (screenBits.bounds.bottom = 342)) then
			begin
				xd := (r.left - r.right) div 2;
				yd := (r.bottom - r.top) div 2;
				x := (((r.right + xd) * screenBits.bounds.right) div 512) - xd - r.right;
				y := (((r.top + yd) * screenBits.bounds.bottom) div 342) - yd - r.top;
				OffsetRect(r, x, y);
			end;
	end;

	procedure DoShowDialog;

		var
			r1, r2, r: Rect;

	begin
		r1 := Dptr^.portBits.bounds;
		r2 := Dptr^.portRect;
		r.top := -1 * r1.top;    {-1.r1.top }
		r.left := -1 * r1.left;
		r.right := (r2.right - r2.left) + r.left;
		r.bottom := (r2.bottom - r2.top) + r.top;
		DoAdjust(r);
		MoveWindow(Dptr, r.left, r.top, True);
		ShowWindow(Dptr);
	end;

	procedure get_resource_error;

		const
			p0 = 'The program had trouble loading a resource, the resource is:';   	{static text}

		var
			myDialog: DialogPtr;
			myDialogPeek: DialogPeek;
			dStorage: DialogRecord;
			itemNumber: integer;
			itemType: integer;
			itemList, itemHandle: Handle;
			dispRect, dRect: Rect;
			theString: str255;
			HMT, zMessage, zAddress: str255;

		procedure DefineDialog (var myDialog: DialogPtr;		{create Dialog in memory}
										var dStorage: DialogRecord);

			const
				statTextLength = 2;
				statTextNu = 2;

			type		{these are for creating the Dialog Template in memory}
				TextT = packed array[1..statTextLength] of char;
				StatTextTitleT = array[1..statTextNu] of string[statTextLength];
				StatTextRectT = array[1..statTextNu] of Rect;
				ButtonsType = record
						CtlHndl: Handle;
						Itemrect: Rect;
						ItemType, ItemLen: SignedByte;
						zTitle: packed array[1..4] of char;
					end;
				StatTextsType = array[1..statTextNu] of record
						statTextHndl: Handle;
						Itemrect: Rect;
						ItemType, ItemLen: SignedByte;
						zText: TextT;
					end;
				ItemListT = record
						ItemCountM1: integer;
						myButtons: ButtonsType;
						myStatTexts: StatTextsType;
					end;
				ItemListTPtr = ^ItemListT;
				ItemListTHdl = ^ItemListTPtr;

			var
				DITLHdl: ItemListTHdl;
				frameRect: Rect;
				zSTTitle: StatTextTitleT;
				zSTRect: StatTextRectT;
				j: integer;

		begin
			SetRect(zSTRect[1], 10, 5, 300, 40);
			SetRect(zSTRect[2], 10, 60, 300, 110);
			DITLHdl := ItemListTHdl(NewHandle(SizeOf(ItemListT)));  	{create the DialogTemplate}
			HLock(handle(DITLHdl));
			with DITLHdl^^ do
				begin
					ItemCountM1 := 1 + statTextNu - 1;
					with myButtons do
						begin
							CtlHndl := nil;
							SetRect(Itemrect, 210, 100, 300, 118);
							frameRect := Itemrect;
							ItemType := CtrlItem + BtnCtrl;
							ItemLen := 4;
							zTitle := ' OK ';
						end;
					for j := 1 to statTextNu do
						with myStatTexts[j] do
							begin
								statTextHndl := nil;
								Itemrect := zSTRect[j];
								ItemType := statText;
								ItemLen := statTextLength;
								NumToString(j - 1, theString);
								zText[1] := '^';
								zText[2] := theString[1];
							end;
				end;
			HUnLock(handle(DITLHdl));
			itemList := Handle(DITLHdl);
		end;

	begin
		DefineDialog(myDialog, dStorage);
		FlushEvents(everyEvent, 0);
		InitCursor;
		SetRect(dRect, 0, 0, 310, 125);
		centerrect(dRect, screenBits.bounds);
		NumToString(id, theString);
		zAddress := Concat('Type: ', rtype, '    Number: ', theString);
		ParamText(p0, zAddress, '', '');
		myDialog := NewDialog(@dStorage, dRect, '', TRUE, DBoxProc, WindowPtr(-1), FALSE, 0, itemList);
		repeat
			ModalDialog(nil, itemNumber);
		until itemNumber = OK;
		myDialogPeek := DialogPeek(myDialog);
		CloseDialog(myDialog);
		DisposHandle(myDialogPeek^.items);
	end;

	procedure show_io_err;

		const
			err_alert_id = 256;
			io_err_string_id = 257;
			fsDSIntErr = -127;

		var
			err_string: Str255;
			offset, alert_result: integer;

	begin
		case err of
			badMDBErr: 
				offset := 1;
			badMovErr: 
				offset := 2;
			bdNamErr: 
				offset := 3;
			dirFulErr: 
				offset := 4;
			dirNFErr: 
				offset := 5;
			dskFulErr: 
				offset := 6;
			dupFNErr: 
				offset := 7;
			eofErr: 
				offset := 8;
			extFSErr: 
				offset := 9;
			fBsyErr: 
				offset := 10;
			fLckdErr: 
				offset := 11;
			fnfErr: 
				offset := 12;
			fnOpnErr: 
				offset := 13;
			fsDSIntErr: 
				offset := 14;
			fsRnErr: 
				offset := 15;
			gfpErr: 
				offset := 16;
			ioErr: 
				offset := 17;
			memFullErr: 
				offset := 18;
			noMacDskErr: 
				offset := 19;
			nsDrvErr: 
				offset := 20;
			nsvErr: 
				offset := 21;
			opWrErr: 
				offset := 22;
			paramErr: 
				offset := 23;
			permErr: 
				offset := 24;
			posErr: 
				offset := 25;
			rfNumErr: 
				offset := 26;
			tmfoErr: 
				offset := 27;
			tmwdoErr: 
				offset := 28;
			volOffLinErr: 
				offset := 29;
			volOnLinErr: 
				offset := 30;
			vLckdErr: 
				offset := 31;
			wrgVolTypErr: 
				offset := 32;
			wrPermErr: 
				offset := 33;
			wPrErr: 
				offset := 34;

			resNotFound: 
				offset := 35;
			resFNotFound: 
				offset := 36;
			addResFailed: 
				offset := 37;
			rmvResFailed: 
				offset := 38;
			resAttrErr: 
				offset := 39;
			mapReadErr: 
				offset := 40;

			otherwise
				;
		end;
		GetIndString(err_string, io_err_string_id, offset);
		if err_string = '' then
			begin
				get_resource_error('STR#', io_err_string_id);
				ExitToShell;
			end;
		ParamText(err_string, '', '', '');
		alert_result := Alert(err_alert_id, nil);
		ExitToShell;
	end;

end.